PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/tvcopy.exe/SLIST.PAS

Pascal/Delphi Source File | 1993-04-18 | 11.6 KB | 367 lines

{$X+}
unit SList;                    {adapted from PhoneLst unit for Phone.pas}

interface

uses
  Objects,Drivers,Views,Dialogs,App, {Turbo Vision units                 }
  Printer;                           {Turbo Pascal standard unit         }

{ This unit implements a TSiteColl, which is a collection of TSite
  objects. It has methods which allow one to view the collection via a list
  box, and to add, edit or delete records. A TSite is simply a record
  containing a Site name, Latitude and Longitude, along with appropriate
  Load and Store methods. TSite can easily be modified to accomodate
  additional data.      }

const
  cmPrintF      = 213;              { Print all TSites                    }
  cmAdd         = 214;              { Add a new TSite                     }
  cmEdit        = 215;              { Edit the current TSite              }
  cmRemove      = 216;              { Remove the current TSite            }

type
  String80 = String[80];
  String60 = String[60];
  String40 = String[40];
  String14 = String[14];
  PWord    = ^word;

  NameStr   = String40;   {was String[40] in Phone example}
  NumberStr = String14;   {was String[12]}
  InfoStr   = String80;

  PSite = ^TSite;
  TSite = object (TObject)
    Name:      NameStr;
    Latitude:  NumberStr;
    Longitude: NumberStr;
    Info:      InfoStr;
    constructor Init (AName: NameStr;
                      ALatitude, ALongitude: NumberStr;
                      Ainfo: InfoStr);
    end;

{ TSiteListBox is a simple descendant of TListBox, with a specialized
  GetText method to display the TSite objects in the list box.          }

  PSiteListBox = ^TSiteListBox;
  TSiteListBox = object (TListBox)
    function GetText (Item: Integer; MaxLen: Integer): String; virtual;
    end;

{ TSiteColl is implemented as a descendant of TCollection. The Show method
  opens up a dialog box which allows viewing and editing of the TSites.    }

  PSiteColl = ^TSiteColl;
  TSiteColl = object (TSortedCollection)
    function Compare(Key1, Key2: Pointer): Integer; virtual;
    procedure FreeItem (Item: pointer); virtual;
    function Show: Word;
    end;

{ TViewDialog is a descendant of TDialog which is used to display the TSite
  information and allow for editing. SiteColl points to the associated
  TSiteColl object, and L points to the list box that displays the TSites. }

  PViewDialog = ^TViewDialog;
  TViewDialog = object (TDialog)
    L: PSiteListBox;
    SiteColl: PSiteColl;
    constructor Init (ASiteColl: PSiteColl);
    procedure HandleEvent (var Event: TEvent); virtual;
    end;

var
    ViewDialog: PViewDialog;
    SiteList: PSiteColl;

{ The RegisterSite procedure takes care of registering the newly defined
  object types so that they can be written to or read from a stream. Only
  those object types which are actually expected to be stored are
  registered.                                                            }

procedure RegisterSite;

implementation   {=================================================}

{ TSite methods }

constructor TSite.Init (AName: NameStr;
                        ALatitude, ALongitude: NumberStr;
                        AInfo: InfoStr);
begin
  Name :=      AName;
  Latitude :=  ALatitude;
  Longitude := ALongitude;
  Info:=       AInfo;
end;

{ TSiteListBox methods }

{ TSiteListBox.GetText returns a composite string containing the name,
  Latitude and Longitude fields of the appropriate TSite object. It shoves
  all of the fields into one string which is then displayed.             }

function TSiteListBox.GetText (Item: Integer; MaxLen: Integer): String;
var
  S: String;
begin
    {0         1         2         3         4         5         6        }
    {012345678901234567890123456789012345678901234567890123456789012345678}
S:=  '                                                                    ';
     {  Site Name                                 Latitude     Longitude  }

Move (PSite (List^.At (Item))^.Name[1],S[1],
  Length (PSite (List^.At (Item))^.Name));

Move (PSite (List^.At (Item))^.Latitude[1],S[43],
  Length (PSite (List^.At (Item))^.Latitude));

Move (PSite (List^.At (Item))^.Longitude[1],S[56],
  Length (PSite (List^.At (Item))^.Longitude));
GetText := S;
end;

{ TSiteColl methods }

function StrUpCase ( S : string ) : string ;   {from JJ Stein}
var
   b                         : byte ;
begin
   for b := 1 to length ( S ) do
      S [ b ]                := UpCase ( S [ b ] ) ;
   StrUpCase                 := S ;
end ;

  {Phonelst unit originally used a TCollection; I (SM) converted this
   to a TSortedCollection with the help of ideas from Jonathan J. Stein}

function TSiteColl.Compare ;
begin
        if PSite (Key1)^.Name < PSite (Key2)^.Name then Compare:= -1
   else if PSite (Key1)^.Name > PSite (Key2)^.Name then Compare:=  1
   else                                                   Compare:=  0;
end ;


procedure TSiteColl.FreeItem;
begin
  if SiteList <> nil then
  begin
  Dispose(PSite(Item))
  end;
end;


{ TSiteColl.Show ExecViews a TViewDialog, and returns
  the result of that ExecView as its own result.  }

function TSiteColl.Show: Word;
begin
  ViewDialog := New (PViewDialog,Init (@Self));
  Show := DeskTop^.ExecView (ViewDialog);
end;

{ ModifyRecord instantiates a dialog box which is used for adding a new
  TSite record or editing an existing one. In the case of adding a record,
  the calling routine passes empty strings as the values of Name, Latitude,
  and Longitude in the Site parameter; upon return, Site contains the new
  values of Name, Latitude & Longitude. In the case of editing, the calling
  routine passes the   existing values of Name, Latitude and Longitude in
  the Site parameter, and they are   replaced by the new values upon return.
  ModifyRecord returns a value equal   to the result of ExecViewing the
  dialog; if the dialog was cancelled by   the user, the Site parameter is
  returned unaltered.                       }

function ModifyRecord ( DSite: PSite; Title: TTitleStr): Word;
var
  R: TRect;
  D: PDialog;
  N,T,G,I: PInputLine;         {Name, laT, lonG, Info}
  Result: Word;

begin
R.Assign (27,7,66,21);    {40 chars wide}
D := New (PDialog,Init (R, Title + 'One Site'));

R.Assign (2,2,34,3);
N := New (PInputLine,Init (R,40));
N^.SetData (DSite^.Name);
D^.Insert (N);
R.Assign (2,1,31,2);
D^.Insert (New (PLabel,Init (R, 'Site Name',N)));

R.Assign (2,5,16,6);
T := New (PInputLine,Init (R,14));
T^.SetData (DSite^.Latitude);
D^.Insert (T);
R.Assign (2,4,14,5);
D^.Insert (New (PLabel,Init (R, 'Latitude',T)));

R.Assign (18,5,33,6);
G := New (PInputLine,Init (R,14));
G^.SetData (DSite^.Longitude);
D^.Insert (G);
R.Assign (18,4,31,5);
D^.Insert (New (PLabel,Init (R, 'Longitude',G)));

R.Assign (2,8,34,9);
I := New (PInputLine,Init (R,80));
I^.SetData (DSite^.Info);
D^.Insert (I);
R.Assign (2,7,20,8);
D^.Insert (New (PLabel,Init (R, 'Remarks',I)));

R.Assign (3,10,17,12);
D^.Insert (New (PButton,Init (R, '~O~k',cmOK,bfDefault)));
R.Assign (19,10,31,12);
D^.Insert (New (PButton,Init (R, 'Cancel',cmCancel,bfNormal)));
D^.SelectNext (False);
Result := DeskTop^.ExecView (D);
if Result <> cmCancel then
  begin
  N^.GetData (DSite^.Name);
  T^.GetData (DSite^.Latitude);
  G^.GetData (DSite^.Longitude);
  I^.GetData (DSite^.Info);
  end;
Dispose (D,Done);
ModifyRecord := Result;
end;

{ TViewDialog methods }

{ TViewDialog.Init is a basic dialog box constructor; nothing fancy here.}

constructor TViewDialog.Init (ASiteColl: PSiteColl);
var
  R: TRect;
  SB: PScrollBar;
begin
R.Assign (2,5,77,18);
TDialog.Init (R, 'Site List');
SiteColl := ASiteColl;
R.Assign (72,2,73,7);
SB := New (PScrollBar,Init (R));
Insert (SB);
R.Assign (2,2,72,7);
L := New (PSiteListBox,Init (R,1,SB));
L^.NewList (SiteColl);
Insert (L);
R.Assign (2,1,70,2);
Insert (New (PStaticText,Init (R,
  '  Site Name                                Latitude     Longitude   ')));
 {0         1         2         3         4         5         6        }
 {012345678901234567890123456789012345678901234567890123456789012345678}

R.Assign (2,8,12,10);
Insert (New (PButton,Init (R,'Add',cmAdd,bfNormal)));
R.Assign (13,8,23,10);
Insert (New (PButton,Init (R,'Edit',cmEdit,bfNormal)));
R.Assign (2,10,12,12);
Insert (New (PButton,Init (R,'Remove',cmRemove,bfNormal)));
R.Assign (46,8,56,10);
Insert (New (PButton,Init (R,'Save',cmOK,bfDefault)));
R.Assign (60,8,70,10);
Insert (New (PButton,Init (R,'Cancel',cmCancel,bfNormal)));
R.Assign (60,10,70,12);              {next button added by JJ Stein}
Insert (New (PButton,Init (R,'Print',cmPrintF,bfNormal)));
SelectNext (False);
end;

{ TViewDialog.HandleEvent takes care of the special commands (cmAdd,cmEdit,
  cmRemove and cmPrintF) used by TViewDialog. It also updates the list box
  display as required, and disables cmEdit and cmRemove commands if the
  TSiteColl is empty.                                                                     }

procedure TViewDialog.HandleEvent (var Event: TEvent);
var S, S2: string;
    i: word;

 {procedure PrintList has a FAR, LOCAL procedure Action contained within
  it.  This code was added to the unit by Jonathan J. Stein, originator
  of the Shazam TurboVision interface generator (76576,470).  }

procedure PrintList ;
   {-----------------------------------------------------------------
   RECORD - no error checking for printer; will crash if offline.
   -----------------------------------------------------------------}
  procedure Action ( P : PSite ) ; FAR ;
  begin
   writeln ( Lst , 'NAME     : ' , P^.Name ) ;
   writeln ( Lst , 'LATITUDE : ' , P^.Latitude  ) ;
   writeln ( Lst , 'LONGITUDE: ' , P^.Longitude ) ;
   S:= P^.Info; S2:= '';
   if length(S) <= 65 then
   writeln ( Lst , 'REMARKS  : ' , S )
   else    {split remarks line at a word break}
     begin
       if pos(' ', S) <> 0 then       {if no breaks, then split at 61}
       begin
         i:= 66;
         repeat                       {find word break}
           dec(i)
         until S[i] = ' ';
       end
       else i:= 66;
       S2:= copy(S,(i+1), length(S));
       S[0]:= chr(i);
       writeln ( Lst , 'REMARKS  : ' , S  );
       writeln ( Lst , '           ' , S2 );
     end;  {end split remarks}
   writeln ( Lst ) ;
  end ;
   {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   PROCESS
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
begin
   writeln ( Lst , 'LISTING OF ALL SITES IN CURRENT FILE ' ) ;
   writeln ( Lst ) ;
   sitecoll^.ForEach ( @Action ) ;
   writeln ( Lst , #12 ) ;                               { Form Feed }
end ;

var
  P: PSite;
begin
TDialog.HandleEvent (Event);
if Event.What = evCommand then
  begin
  case Event.Command of
    cmAdd: begin
      P := New (PSite,Init ( '','','',''));
      if ModifyRecord (P,'Add ') <> cmCancel then SiteColl^.Insert (P)
      else Dispose (P,Done);
      end;
    cmEdit: ModifyRecord (PSite (SiteColl^.At (L^.Focused)),'Edit ');
    cmRemove: SiteColl^.AtDelete (L^.Focused);
    cmPrintF: PrintList;    {<-- add this line}
    end;
  L^.SetRange (L^.List^.Count);
  L^.DrawView;
  end;
if SiteColl^.Count >= 1 then EnableCommands ([cmRemove,cmEdit,cmPrintF])
else DisableCommands ([cmRemove,cmEdit,cmPrintF]);
end;

{ stream registration records }

const
  srSiteColl   = 10502;

  RSiteColl: TStreamRec = (
    ObjType: srSiteColl;
    VMTLink: Ofs (TypeOf (TSiteColl)^);
    Load: @TSiteColl.Load;
    Store: @TSiteColl.Store
  );

procedure RegisterSite;

begin
RegisterType (RSiteColl);
end;

end.